Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/BTREE.PAS

Pascal/Delphi Source File | 1996-04-20 | 10KB | 346 lines

UNIT BTree;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ BTree routines for Opus 1.73a                 Last changed: 20.04.96  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-93 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                         ,Birger Kristensen                               ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, PoPTypes, Dos;

TYPE
  FindType = (Previous,Match,Next);
  CompProc = function(var ALine,Desire; L:char):integer;

  TA=RECORD
    Fill   : BYTE;
    Zone,
    Net,
    Node,
    Point  : INTEGER;
  END;

  CtlBlk = record
    BlkSize : word;
    Root,
    HiBlk,
    LoLeaf,
    HiLeaf,
    Free : longint;
    Lvls,
    Parity : word;
  end;

  IdxRefBlk = record
    IdxOfs,
    IdxLen : word;
    IdxData,
    IdxPtr : longint;
  end;

  LeafRefBlk = record
    KeyOfs,
    KeyLen : word;
    KeyVal : longint;
  end;

  INodeBlk = record
    First,
    BLink,
    FLink : LongInt;
    Cnt   : Integer;
    StrOf : Word;
    IdxRef : array[0..49] of IdxRefBlk;
  end;

  LNodeBlk = record
    First,
    BLink,
    FLink : longint;
    Cnt : integer;
    StrOf : word;
    LeafRef : array[0..49] of LeafRefBlk;
  end;

  RealDatRec = record
    Zone,
    Net,
    Node,
    Point : integer;
    CallCost,
    MsgFee,
    NodeFlags : word;
    ModemType,
    PhoneLen,
    PassWordLen,
    BNameLen,
    SNameLen,
    CNameLen,
    PackLen,
    Baud : byte;
    Pack : array[1..160] of char;
  end;

  DatRec = record
    Zone,
    Net,
    Node,
    Point : integer;
    CallCost,
    MsgFee,
    NodeFlags : word;
    ModemType,
    Password : string[9];
    Phone,
    BName,
    CName,
    SName : string[39];
    BaudRate,
    RecSize : byte;
  end;

  KeyStr=S30;

FUNCTION FindKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
FUNCTION NextKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
FUNCTION PrevKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;

IMPLEMENTATION

USES NetFile;

function CompName(var S,D; L:char):integer; far;
var
  Key,Des : S160;
  Len : byte absolute L;

begin
  Key[0]:=L;
  Des[0]:=L;
  Move(S,Key[1],Len);
  Move(D,Des[1],Len);
  if Key>Des then CompName:=1 else
    if Key<Des then CompName:=-1 else CompName:=0;
end;

{
function CompAddress(var S,D; L:char):integer; far;
var
  Key : TA absolute S;
  Des : TA absolute D;
  I : byte;
  K : integer;

begin
  IF l=#6 THEN Des.Point:=0;
  I:=0;
  repeat
    Inc(I);
    case I of
      1 : K:=Key.Zone-Des.Zone;
      2 : K:=Key.Net-Des.Net;
      3 : K:=Key.Node-Des.Node;
      4 : begin
            if L=#6 then Key.Point:=0;
            K:=Key.Point-Des.Point;
          end;
    end;
  until (I=4) or (K<>0);
  CompAddress:=K;
end;
}

  FUNCTION CompAddress(VAR s, d; l:CHAR): Integer;
  TYPE
    AT = RECORD
      Len : Byte;
      zone,net,node,point: Integer;
    END;
  VAR
    k : Integer;
  BEGIN
    k:=AT(s).Zone-AT(d).Zone;
    IF k=0 THEN
    BEGIN
      k:=AT(s).Net-AT(d).Net;
      IF k=0 THEN
      BEGIN
        k:=AT(s).Node-AT(d).Node;
        IF k=0 THEN
        BEGIN
          IF BYTE(s)=6 THEN AT(s).Point:=0;
          IF BYTE(d)=6 THEN AT(d).Point:=0;
          k:=AT(s).Point-AT(d).Point;
        END;
      END;
    END;
    CompAddress:=k;
  END;


function Find(var F: TNetFile; Desired:S160; Compare:CompProc; var KeyL:byte; FT:FindType):longint;
var
  Buf : array[0..511] of byte;
  Ctl : CtlBlk absolute Buf;
  INode : INodeBlk absolute Buf;
  LNode : LNodeBlk absolute Buf;
  SaveCtl : CtlBlk;
  count : byte;
  currentblocknumber : longint;
  difference : integer;
  s : string;
begin
  f.Seek(0);
  f.BlockRead(Buf,SizeOf(Buf));
  Move(Buf,SaveCtl,SizeOf(Ctl));
  f.Seek(SaveCtl.BlkSize*Ctl.Root);
  f.BlockRead(Buf,SizeOf(Buf));
  currentblocknumber := -1;
  count := 0;
  While INode.First <> -1 do { S¢g i indexblokke, indtil leafnode er fundet }
    begin
      difference := -1;
      While (count < INode.Cnt) and (difference < 0) do
        begin
          FillChar(S,SizeOf(S),#0);
          Move(Buf[INode.IdxRef[count].IdxOfs],S[1],INode.IdxRef[count].IdxLen);
          BYTE(s[0]):=INode.IdxRef[count].IdxLen;
          difference := Compare(S,Desired,Chr(inode.IdxRef[count].IdxLen));
          if (difference = 0) AND (FT = Match) then { Her afslutter s¢gning, hvis Match }
           begin
             Find:=INode.IdxRef[count].IdxData;
             KeyL:=INode.IdxRef[count].IdxLen;
             exit;
           end;
          IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
        end;
      IF difference = 0 then currentblocknumber := inode.IdxRef[Count].IdxPtr
        else IF Count = 0 THEN currentblocknumber := inode.First
               ELSE currentblocknumber := inode.IdxRef[Count-1].IdxPtr;
      f.Seek(SaveCtl.BlkSize*currentblocknumber);
      f.BlockRead(Buf,SizeOf(Buf));
      count := 0;
    end;
  difference := -1;
  count := 0;
  while (count < LNode.Cnt) and (difference < 0) do { Vi har nu fundet leafblokken }
   begin
          FillChar(S,SizeOf(S),#0);
          Move(Buf[lNode.leafRef[count].keyOfs],S[1],lNode.leafRef[count].keyLen);
          BYTE(s[0]):=lNode.leafRef[count].keyLen;
          difference := Compare(S,Desired,Chr(lnode.leafRef[count].keyLen));
          if difference = 0 then
           begin
             case FT of
               Previous : begin
                            if count > 0 then
                              begin
                                find:=lNode.leafRef[count-1].keyVal;
                                KeyL:=lNode.leafRef[count-1].keyLen;
                              end
                            else
                              begin
                                if Lnode.blink <> 0 then
                                  begin
                                    f.Seek(SaveCtl.BlkSize*Lnode.blink);
                                    f.BlockRead(Buf,SizeOf(Buf));
                                    find:=lnode.LeafRef[lnode.cnt-1].KeyVal;
                                    KeyL:=lnode.LeafRef[lnode.cnt-1].KeyLen;
                                  end
                                else
                                 begin
                                   find:=lnode.LeafRef[0].KeyVal;
                                   KeyL:=lnode.LeafRef[0].KeyLen;
                                 end;
                              end;
                          end;
               Match    : begin
                            find:=lnode.LeafRef[count].KeyVal;
                            KeyL:=lnode.LeafRef[count].KeyLen;
                          end;
               Next     : begin
                            if count < lnode.cnt-1 then
                              begin
                                find:=lnode.LeafRef[count+1].KeyVal;
                                KeyL:=lnode.LeafRef[count+1].KeyLen;
                              end
                            else
                              begin
                                if Lnode.flink <> 0 then
                                  begin
                                    f.Seek(SaveCtl.BlkSize*Lnode.flink);
                                    f.BlockRead(Buf,SizeOf(Buf));
                                    find:=lNode.leafRef[0].keyval;
                                    KeyL:=lNode.leafRef[0].keyLen;
                                  end
                                else
                                 begin
                                   find:=lnode.LeafRef[lnode.cnt-1].KeyVal;
                                   KeyL:=lnode.LeafRef[lnode.cnt-1].KeyLen;
                                 end;
                              end;
                          end;
             end;
           end;
     IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
     IF (difference>0) OR (Count=LNode.Cnt) THEN
     BEGIN
       Count:=LNode.Cnt;
       Find:=-1;
     END;
   end;
end;


FUNCTION FindKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
VAR
  Idx : TNetFile;
  Kl  : BYTE;
BEGIN
  FindKey:=FALSE;
  IF Idx.Open(FName,1,FALSE) THEN
  BEGIN
    RecNum:=Find(Idx,Desired,CompAddress,Kl,Match);
    Idx.Close;
    FindKey:=(RecNum<>-1);
  END;
END;

FUNCTION NextKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
VAR
  Idx : TNetFile;
  Kl  : BYTE;
BEGIN
  NextKey:=FALSE;
  IF Idx.Open(FName,1,FALSE) THEN
  BEGIN
    RecNum:=Find(Idx,Desired,CompAddress,Kl,Next);
{    NextKey:=TRUE;}
    NextKey:=(RecNum<>-1);
    Idx.Close;
  END;
END;

FUNCTION PrevKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
VAR
  Idx : TNetFile;
  Kl  : BYTE;
BEGIN
  PrevKey:=FALSE;
  IF Idx.Open(FName,1,FALSE) THEN
  BEGIN
{    PrevKey:=TRUE;}
    RecNum:=Find(Idx,Desired,CompAddress,Kl,Previous);
    PrevKey:=(RecNum<>-1);
    Idx.Close;
  END;
END;

END.